Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue25/system/MATCH.PAS

Pascal/Delphi Source File | 1997-08-08 | 5.3 KB | 222 lines

unit Match;
{
  File: match.pas
  Author: Kevin Boylan

  This code is meant to allow wildcard pattern matches.  It is VERY useful for matching filename wildcard
  patterns.  It allows unix grep-like pattern comparisons, for instance:

    ?    Matches any single characer
    *    Matches any contiguous characters
    [abc]    Matches a or b or c at that position
    [^abc]    Matches anything but a or b or c at that position
    [!abc]    Ditto
    [a-e]    Matches a through e at that position

    'ma?ch.*'    -Would match match.exe, mavch.dat, march.on, etc
    'this [e-n]s a [!zy]est' -Would match 'this is a test', but would not match 'this as a yest'

  This is a Delphi VCL translation from C code that was downloaded from CIS.  That C code was written
  by J. Kerceval and released to public domain 02/20/1991.  This code is ofcourse also public domain.
  I would appreciate it if you would let me know if you find any bugs.  I would also appreciate any
  notes sent my way letting me know if you find it useful.  My email address is
  Internet:    [e-mail]

  Some tidying up by Dave Jewell.
}

interface

function IsMatch (const pattern, text: String): Boolean;

implementation

uses SysUtils;

const
    { match defines }
    MATCH_PATTERN        = 6;
    MATCH_LITERAL        = 5;
    MATCH_RANGE            = 4;
    MATCH_ABORT            = 3;
    MATCH_END            = 2;
    MATCH_VALID            = 1;

function matche( pattern, text: String ): Integer; forward;
function match_after_star( pattern, text: String ): Integer; forward;

function IsMatch (const pattern, text: String ): Boolean;
begin
    Result := matche( pattern, text ) = 1;
end;

function matche (pattern, text: String): Integer;
var
    invert, member_match, loop: Boolean;
    range_start, range_end, p, t, plen, tlen: Integer;
begin
    p := 1; t := 1;
    pattern := LowerCase (pattern);
    text := LowerCase (Text);
    plen := Length (pattern) ;
    tlen := Length (text);
    Result := 0;

    while (Result = 0) and (p <= plen) do
    begin
        if t > tlen then
        begin
            if (pattern [p] = '*') and (p + 1 > plen) then
                Result := MATCH_VALID
            else
                Result := MATCH_ABORT;
            Exit;
        end
    else case pattern[p] of
          '*':
        Result := match_after_star (Copy (pattern, p, plen), Copy (text,t,tlen));
         '[':
            begin
            Inc (p);
            invert := False;
            if pattern [p] in ['!', '^'] then
            begin
                invert := True;
            Inc (p);
                end;

        if pattern[p] = ']' then
        begin
            Result := MATCH_PATTERN;
            Exit;
        end;

        member_match := False;
        loop := True;
        while loop and (pattern[p] <> ']') do
                begin
            range_start := p;
            range_end := p;
            Inc (p);
            if p > plen then
            begin
                Result := MATCH_PATTERN;
            Exit;
                 end;

            if pattern[p] = '-' then
                    begin
                Inc(p);
                range_end := p;
                if (p > plen) or (pattern[range_end] = ']') then
                begin
                    Result := MATCH_PATTERN;
                Exit;
                        end;
            Inc(p);
                    end;

            if p > plen then
            begin
                Result := MATCH_PATTERN;
                Exit;
               end;

            if range_start < range_end then
              begin
                if (text[t] >= pattern[range_start]) and
               (text[t] <= pattern[range_end]) then
            begin
                member_match := True;
                loop := False;
            end;
            end
            else
                    begin
                  if (text[t] >= pattern[range_end]) and
                  (text[t] <= pattern[range_start]) then
                begin
                member_match := True;
                loop := False;
            end;
                    end;
                end;

            if (invert and member_match) or (not(invert or member_match)) then
                begin
            Result := MATCH_RANGE;
            Exit;
        end;

        if member_match then while (p <= plen) and (pattern[p] <> ']') do Inc(p);
        if p > plen then begin
               Result := MATCH_PATTERN;
            Exit;
        end;
            end; { MATCH_CHAR_RANGE_OPEN: }

        else if pattern[p] <> '?' then
            if (pattern[p] <> text[t]) then
            Result := MATCH_LITERAL;
        end; { Case pattern[p] }

    Inc(p);
    Inc(t);
    end;

    if Result = 0 then
    if (t <= tlen) then
           Result := MATCH_END
        else
        Result := MATCH_VALID;
end;

function match_after_star( pattern, text: String ): Integer;
var
    p, t, plen, tlen: Integer;
begin
    Result := 0;
    p := 1; t := 1;
    plen := Length (pattern);
    tlen := Length(text);
    while ((t <= tlen) and (p < plen)) and
    (pattern[p] = '?') or
    (pattern[p] = '*') do
    begin
        if pattern [p] = '?' then Inc(t);
    Inc(p);
    end;

    if t > tlen then begin
    Result := MATCH_ABORT;
    Exit;
    end;

    if p > plen then begin
        Result := MATCH_VALID;
    Exit;
    end;

    repeat
        if (pattern[p] = text[t]) or (pattern[p] = '[') then
    begin
            pattern := Copy (pattern, p, plen);
        text := Copy (text,t,tlen);
        plen := Length (pattern);
        tlen := Length (text);
        p := 1; t := 1;
          Result := matche( pattern , text );
        end;

        if t > tlen then begin
          Result := MATCH_ABORT;
        Exit;
        end;

    Inc(t);
    until (Result = 1) or (t > tlen);
end;

end.